home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG: Games / PC-SIG Games (PC-SIG).iso / 1133 / WG1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-09-02  |  16.9 KB  |  488 lines
  1. Unit WG1;
  2. {part of Worldgen}
  3.  
  4. INTERFACE
  5.  
  6. Uses CRT, Printer, Dos, Graph, Turbo3, Graph3;
  7.  
  8. Const
  9.    OCRA : Array [0..9] of Array [0..7] of Byte =
  10.      (($0,$0,$70,$50,$50,$50,$70,$0),
  11.       ($0,$0,$60,$20,$20,$70,$70,$0),
  12.       ($0,$0,$70,$10,$70,$60,$70,$0),
  13.       ($0,$0,$60,$20,$70,$30,$70,$0),
  14.       ($0,$0,$50,$50,$70,$10,$10,$0),
  15.       ($0,$0,$70,$40,$70,$30,$70,$0),
  16.       ($0,$0,$70,$40,$70,$50,$70,$0),
  17.       ($0,$0,$70,$10,$10,$30,$30,$0),
  18.       ($0,$0,$70,$50,$70,$50,$70,$0),
  19.       ($0,$0,$70,$50,$70,$30,$30,$0));
  20.       {Ocra is computer-style letters 0 to 9}
  21.  
  22.    Grid : Array [0..7] of Byte =
  23.       ($80,$80,$80,$80,$80,$80,$80,$FF);
  24.  
  25.    Gasses: Array [0..8] of string[20] =
  26.    ('Hydrogen','Helium','Oxygen','Nitrogen','Halogens','Argon',
  27.     'Carbon Dioxide','Water Vapour','Methane');
  28.  
  29.    Mineral_Name: Array [0..5] of string [15] =
  30.     ('Oxygen','Silicon','Aluminium','Iron','Other metals','Radioactives');
  31.  
  32.    Bode_Number: Array[1..18] of real =
  33.    ( 0.2, 0.4, 0.7, 1.0, 1.6, 2.8, 5.2, 10.0, 19.6, 38.8, 77.2, 154.0, 307.4,
  34.     614.8, 1229.2, 2458.0, 4916.0, 9832.0);
  35.  
  36.    Star_Name_Tags: Array [0..13] of string[2] =
  37.    ('B0','B5','A0','A5','F0','F5','G0','G5','K0','K5','M0','M5','M9','DG');
  38.  
  39.    Days_In_Month: Array [1..12] of Integer =
  40.    (31,28,31,30,31,30,31,31,31,31,30,31);
  41.  
  42.    Month_Of_Year: Array [1..12] of string [10] =
  43.    ('January','February','March','April','May','June',
  44.     'July','August','September','October','November','December');
  45.  
  46.    Day_Of_Week: Array [0..6] of string [10] =
  47.    ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
  48.  
  49. Var
  50.   Year,Month,Day,Dayofweek,Hour,Minute,Second,Sec100 : Word;
  51.          Screen_Selection : Integer;
  52.                    C_Or_T : Byte; {colour mode or text mode?}
  53.              X_Coordinate : Integer; {System "X" co-ordinate}
  54.              Y_Coordinate : Integer; {System "Y" co-ordinate}
  55.              Z_Coordinate : Integer; {System "Z" co-ordinate}
  56.  I, IA, IB, IC, ID, N, NN : Integer;     {Local variables}
  57.  X, X1, X2, Y, Y1, Y2, Z, xx, yy : Integer;     {Local variables}
  58.      A, B, C, D           : String [1];  {Local variables}
  59.   E, K, R, S, T, U, V, W  : Integer;     {Local Variables}
  60.         Systems_In_Memory : byte; {check if a system is loaded or generated}
  61.                 WG_System : String [40];  {A string taken from System_Details}
  62.          Protected_System : String [40];  {used to save systems in editing etc.}
  63.           System_Location : String [3];
  64.                  Mini_Map : Array [0..9] of String [20];
  65.            System_Details : Array [0..9, 0..9] of String [40];
  66.               Sector_Name : String [15];
  67.               Sector_File : Text;
  68.                    Status : Integer;
  69.               Menu_Status : Integer;
  70.                     Check : Integer;
  71.                      Tilt : Integer;         {Planetary axial tilt}
  72.                     Range : Integer;
  73.          Second_Star_Size : Integer;
  74.         Second_Star_Orbit : Integer;
  75.                        OK : Boolean;
  76.                    Bypass : Integer;
  77.              Introduction : Text;
  78.                 Text_File : Text;
  79.                   Help_Me : Text;
  80.                 Help_File : String[8];
  81.                 File_Name : String[20];
  82.           Line, Help_Line : String[80];
  83.                   Command : Char;
  84.                 Star_Type : String[2];
  85.                    Star_H : Integer;
  86.               Star_Chance : Integer;
  87.            Star_Selection : Integer;
  88.           Stars_In_System : Integer;
  89.                Luminosity : Real;
  90.        Primary_Luminosity : Real;
  91.                Exact_Mass : Real;
  92.              Exact_Radius : Real;
  93.              Oxygen_World : Integer;
  94.                     Dummy : Char;         {parameter from keyboard}
  95.              Old_X, Old_Y : Integer;
  96.                World_Type : Integer;
  97.                      Band : Integer;      {gas giant banding}
  98.               Ring_Number : Integer;      {gas giant rings}
  99.             Planet_Number : Integer;
  100.               Planet_Code : String[1];
  101.                Belt_Width : Integer;      {asteroid belt density etc.}
  102.        Solar_System_Count : Integer;      {count parameters are used}
  103.         Binary_Star_Count : Integer;      {in statistical routines}
  104.        Oxygen_World_Count : Integer;
  105.           Gas_Giant_Count : Integer;
  106.        Vacuum_World_Count : Integer;
  107.        Poison_World_Count : Integer;
  108.       Asteroid_Belt_Count : Integer;
  109.        Total_Planet_Count : Integer;
  110.          Black_Hole_Count : Integer;
  111.           Protostar_Count : Integer;
  112.          Ring_World_Count : Integer;
  113.         Second_Star_Count : Integer;
  114.          Dust_Cloud_Count : Integer;
  115.         Statistics_Status : Integer;
  116.                Body_Count : Integer;
  117.             Printer_Setup : Integer;
  118.               Planet_Mass : Real;
  119.  
  120.                 Continent : Integer;      {for world mapping}
  121.               Star_Radius : Integer;
  122.       Star_Display_Radius : Integer;
  123.         Binary_Star_Orbit : Array [0..1] of integer;      {for binary stars}
  124.      Binary_Star_distance : Array [0..1] of integer;
  125.        Binary_Star_Radius : Array [0..1] of real;
  126.    Binary_Star_Atmosphere : Array [0..1, 0..1] of integer;
  127.          Binary_Star_Mass : Array [0..1] of Real;
  128.             Binary_Star_G : Array [0..1] of Real;
  129.             Binary_Star_x : array [0..1] of integer;
  130.   Binary_Star_Temperature : array [0..1] of real;
  131.    Binary_Star_Luminosity : array [0..1] of real;
  132.          Binary_Star_Type : array [0..1] of String[2];
  133.          Binary_Star_Size : array [0..1] of Integer;
  134.  
  135.                 Moon_Size : Array [0..20] of Integer;
  136.  
  137.             Moon_diameter : Real;
  138.                Moon_width : String[8]; {Moon diameter as string}
  139.             Moon_distance : Real;
  140.       Moon_orbital_Radius : String[8]; {moon distance as string}
  141.            Eccentricity_X : Integer;
  142.            Eccentricity_Y : Integer;
  143.         Mean_Eccentricity : Real;
  144.                Atmosphere : Array [0..8] of Integer; {gasses}
  145.                  Pressure : Real;
  146.                 Air_Force : String [5]; {pressure as string}
  147.                   Gravity : Real;
  148.                      Pull : String [7]; {gravity as string}
  149.               Temperature : Real;
  150.                      Heat : String [8]; {temperature as string}
  151.                Distortion : String [6]; {orbital eccentricity as string}
  152.       Primary_Temperature : Real;
  153.               Edit_Status : Integer;
  154.              Dust_Density : Integer;
  155.                 Gas_Level : Integer;
  156.            Sun_Shield_Pos : Integer;
  157.               Inverse_Sqr : Real;
  158.          Orbital_Distance : Real;
  159.     Total_Binary_Distance : Real;
  160.            Orbital_radius : String [6]; {Orbital distance as string}
  161.            Orbital_Period : Real;
  162.              Orbital_Time : String [6]; {Orbital_Period as string}
  163.          Orbital_Velocity : Real;
  164.             Circumference : Real;
  165.                  RW_Width : Real;
  166.                  Old_Seed : Array [0..1] of integer;
  167.                  Minerals : Array [0..5] of integer;
  168.              Primary_Mass : Real;
  169.           Rotation_Period : Real;
  170.             Magnification : Integer;
  171.                     Ratio : Integer;
  172.  
  173.                Native_Life: Integer;
  174.          Native_Technology: Integer;
  175.                   Colonies: Array [1..3] of Byte;
  176.                             {1 is human, 2 is alien, 3 is native (eg cities)}
  177.              Moon_Colonies: Array [0..20, 1..3] of Integer;
  178.                             {1 is human, 2 is alien, 3 is native}
  179.                     Maxcol: Integer;
  180.                 RandomSeed: Array [0..1] of Integer;
  181.                    Beep_On: Byte;
  182.                 beep_pitch: Integer;
  183.             Demonstration : Byte;
  184.             Security_Code : String [20]; {used by password system}
  185.            Security_Level : Byte;
  186.              Entered_Code : String [20];
  187.              Security_Tag : String [1];  {used for securing individual systems}
  188.                Map_Choice : Byte;
  189.                Map_buffer : Array [0..56,0..206] of byte;
  190.              Cursor_Buffer: Array [0..6,6..30] of byte;
  191.         Cursor_X, Cursor_Y: Integer;
  192.  Old_Cursor_X,Old_Cursor_Y: Integer;
  193.                 Small_Map : Array [0..10,0..22] of byte;
  194.                    Astral : Byte; {switch for astrolabe utility}
  195.              Initial_Angle: Integer;
  196.              Current_Angle: Array [1..17] of Word;
  197.               Time_Elapsed: Real;
  198.              Angle_Per_Day: Real;
  199.                 Days_Since: Real;
  200.                Total_Angle: Real;
  201.        System_Inclination : Integer;
  202. Planet_Orbit_Displacement : Array [1..17] of Byte;
  203.               Bypass_Setup: Byte;
  204.               Bypass_Title: Byte;
  205.                  Help_Used: Byte;
  206.  
  207. Procedure WG_TextColor(Selected : Word);
  208. Procedure Tell_The_Time;
  209. Procedure Top_of_Menu_Screens;
  210. Procedure WriteSafe(Ln_or_not: Byte; Anything: String);
  211. Procedure Screen_Dump;
  212. Procedure Beep_Wait;
  213. Procedure Numbers (S,T,U,V:Integer);
  214. Procedure No_Sector_Error;
  215. Procedure ShowText;
  216. Procedure Colour_Selection;
  217. Procedure Setup_Printer;
  218. Procedure Get_Code_Word;
  219. Procedure HELP(Menu_Choice: string; Menu_Options: String);
  220. Procedure Have_A_Nice_Day;
  221. Procedure Go_Away(X,Y: Integer);
  222. Procedure Show_Disk_Error(V: Integer);
  223.  
  224. Implementation
  225.  
  226. Procedure WG_TextColor(Selected : Word);
  227. Begin;
  228.   If Screen_Selection = 2 then Textcolor(Selected) else
  229.    if selected > blink then Textcolor(White+Blink)
  230.      else textcolor(white);
  231. End;
  232.  
  233. Procedure Tell_The_Time; {does what it says}
  234. Begin;
  235.     Getdate(Year,Month,Day,Dayofweek);
  236.     Gettime(Hour,Minute,Second,Sec100);
  237.     Write('Time is ',Hour,'.');
  238.     If Minute < 10 then write ('0');
  239.     Write(minute,' hours on ',Day_of_Week[dayofweek],', ',Day);
  240.     Case day of
  241.       1,21,31 : Write('st');
  242.       2,22 : Write('nd');
  243.       3,23 : Write('rd');
  244.       4..20, 24..30: Write('th');
  245.     end;
  246.     Writeln(' of ',Month_Of_Year[Month],' ',Year);
  247. End;
  248.  
  249. Procedure Top_of_Menu_Screens; {Title + Tell_The_Time}
  250. Begin;
  251.     If C_or_T = 1 then TextMode(C80) else clrscr;
  252.     C_or_T := 0;
  253.     WG_Textcolor(White);
  254.     Writeln('World Generator 1.3 - Copyright (c) 1988,9 - By Marcus L. Rowland');
  255.     Tell_The_Time;
  256.     If Systems_In_Memory > 0 then write (Systems_In_Memory) else write ('No');
  257.     Write(' systems in memory : Beep is ');
  258.     If Beep_On = 1 then write ('on') else write ('off');
  259.     Write (' : Display ');
  260.     Case Screen_Selection of
  261.     0 : write ('Mono 1');
  262.     1 : write ('Mono 2');
  263.     2 : write ('Colour');
  264.     3 : write ('Not Selected');
  265.     end;
  266.     Writeln(' : Security level ',Security_Level,#10#13);
  267.     WG_Textcolor(LightGreen);
  268. End;
  269.  
  270. Procedure WriteSafe(Ln_or_not: Byte; Anything: String);
  271. {write to printer without crashing if it is off-line}
  272. Begin;
  273.  {$I-}
  274.  If Ln_or_Not = 0 then Write(Lst,anything) else Writeln(Lst,anything);
  275.  {$I+};
  276.  OK := (IOresult = 0);
  277. End;
  278.  
  279. Procedure Screen_Dump;
  280. Begin;
  281.   Inline($55/$CD/$05/$5D);
  282. End;
  283.  
  284. Procedure Beep_Wait; {Does what it says}
  285. Begin;
  286.   If Demonstration = 0 then begin;
  287.     If Beep_On = 1 then begin;
  288.       Sound(beep_pitch);            {This method seems to work}
  289.       Delay(200);            {better than "repeat until keypressed"}
  290.       NoSound;
  291.     End;                     {suggested in the Turbo manual, and}
  292.     Read(Kbd,Dummy);         {produces the variable "Dummy"}
  293.     Dummy := Upcase(Dummy);  {which is always upper case}
  294.     If (Dummy = #27) and Keypressed then begin;
  295.       Read(kbd,Dummy);       {eliminate function key presses}
  296.       Dummy:= ' ';
  297.     end;
  298.   end
  299.   else if Demonstration <> 0 then begin
  300.     Delay (1500);
  301.     If Keypressed then Demonstration := 2;
  302.   end;
  303.   End;
  304.  
  305. Procedure Numbers (S,T,U,V:Integer);
  306.   {Draw an OCRA number character at coordinates S,T, number is U, Colour
  307.    is V}
  308.    Begin;
  309.      Pattern(OCRA[U]);
  310.      Fillpattern(S,T,S+5,T+5,V);
  311.    End;
  312.  
  313. Procedure No_Sector_Error;
  314. {makes things a little more idiot proof}
  315.    Begin;
  316.      Writeln;
  317.      WG_Textcolor(LightRed+Blink);
  318.      Writeln('WARNING');
  319.      WG_Textcolor(Yellow);
  320.      Writeln('You have asked to see a sector, or use sector data,');
  321.      Writeln('or save a sector, before loading or generating one'#10#13'Please choose another option');
  322.      Writeln;
  323.      WG_Textcolor(White);
  324.      Writeln('Press any key to continue');
  325.      Beep_wait;
  326.      WG_Textcolor(Yellow);
  327.    End;
  328.  
  329. Procedure Show_Disk_Error(V: Integer);
  330. {Does what it says}
  331.    Begin;
  332.       Writeln;
  333.       WG_Textcolor(LightRed+Blink);
  334.       Writeln('WARNING');
  335.       WG_Textcolor(Yellow);
  336.       Case V of
  337.         1: writeln('Unable to load sector file');
  338.         2: writeln('Unable to save sector file');
  339.         3: writeln('Unable to load text file ',File_Name,', or file does not exist');
  340.       end;
  341.       Writeln;
  342.       Writeln ('Please check for errors before trying again'#10#13'Thank you for your co-operation');
  343.       Writeln;
  344.       If Random(6) = 0 then writeln ('The computer is YOUR friend');
  345.       Writeln;
  346.       WG_Textcolor(White);
  347.       Writeln('Press any key to continue');
  348.       Beep_wait;
  349.     End;
  350.  
  351.  
  352. Procedure ShowText;
  353. {Get a text file from the disk and show it on-screen}
  354. Begin;
  355.   If Demonstration = 2 then exit;
  356.   Assign(Text_File,File_Name);
  357.   {$I-};
  358.   Reset(Text_File);
  359.   {$I+};
  360.   OK := (IOresult = 0);
  361.   if not OK then begin;
  362.       Show_Disk_Error(3);
  363.       Exit;
  364.   End;
  365.   WG_Textcolor(Yellow);
  366.   Repeat
  367.     ReadLn(Text_File,Line);
  368.     Writeln(Line);
  369.   until EOF(Text_File);
  370.   Close(Text_File);
  371.   WG_Textcolor(White);
  372.   Writeln;
  373.   If Demonstration = 0 then writeln ('Press Any Key To Continue')
  374.     else Writeln ('Press Any Key To Interrupt');
  375.   WG_Textcolor(yellow);
  376.   Beep_Wait;
  377. End;
  378.  
  379. Procedure Colour_Selection;
  380. Begin;
  381.   C_or_T := 1;
  382.   if Screen_Selection = 1 then Begin;
  383.           Graphmode;
  384.           Palette(1);
  385.       end
  386.       else Begin
  387.           GraphColorMode;
  388.           If Screen_Selection = 2 then Palette(2) else Palette(3);
  389.       end;
  390. end;
  391.  
  392. Procedure Setup_Printer;
  393. Begin;
  394.   Writeln('Set Up Procedure'#10#13'Switch printer on, move to top of form');
  395.   Repeat;
  396.   Writeln('Enter page length eg. 66 [US size] 70 [English A4 paper]');
  397.     Repeat;
  398.       Readln(A,B);
  399.       If A >= '0' then if A <= '9' then Val(A,IA,R) else IA := -1;
  400.       If B >= '0' then if B <= '9' then Val(B,IB,R) else IA := -1;
  401.     Until IA <> -1;
  402.     Printer_Setup := (10 * IA) + IB;
  403.     Writeln('Your page is ',Printer_Setup,' Lines long [y/n]');
  404.     Beep_Wait;
  405.   Until Dummy = 'Y';
  406. Writesafe(1,Chr(27)+'C'+Chr(Printer_Setup)+Chr(27)+'N'+Chr(4));
  407. End;
  408.  
  409. Procedure Get_Code_Word;
  410. Begin;
  411.    Entered_Code := '';
  412.    Repeat
  413.      Beep_wait;
  414.      If Dummy <> #13 then Entered_Code := Entered_Code + Upcase(Dummy);
  415.      Write ('*');
  416.    Until Dummy = #13;
  417. End;
  418.  
  419.  
  420. Procedure HELP(Menu_Choice: string; Menu_Options: String);
  421. Var
  422.   Valid_Choice: Byte;
  423. Begin;
  424.   Top_of_menu_screens;
  425.   file_Name := 'WGHELP\'+Menu_Choice+'.WGH';
  426.   ShowText;
  427.   Valid_Choice := 0;
  428.   Repeat
  429.    For N:= 1 to length(Menu_Options) do
  430.      if (Dummy = Copy(Menu_Options,n,1))
  431.        or (Dummy = '#') then Valid_Choice := 1;
  432.    If Valid_Choice = 0 then Beep_Wait;
  433.   Until Valid_choice = 1;
  434.   If Dummy = ' ' then exit;
  435.   If Dummy <> '#' then file_name :='wghelp\'+Menu_Choice+Dummy+'.WGH';
  436.   if Dummy = '#' then file_Name :='wghelp\COPYRITE.WGH';
  437.   ClrScr;
  438.   showtext;
  439. End;
  440.  
  441.  
  442. Procedure Have_A_Nice_Day; {set security clearance}
  443. Begin;
  444.   Top_Of_Menu_Screens;
  445.     If Security_Level > 0 then writeln ('Please enter your security code')
  446.    else Writeln ('Enter a code word or phrase, maximum 20 characters');
  447.    Get_Code_Word;
  448.    If Security_Level > 0 then if Entered_Code <> Security_Code then begin;
  449.      Writeln (#10#13'SORRY - WRONG CODE WORD'#10#13'Press any key to continue'#10#13'Have a nice day!');
  450.      beep_wait;
  451.      exit;
  452.    end;
  453.    Security_Code := Entered_Code;
  454.    Repeat;
  455.      Top_Of_Menu_Screens;
  456.      Writeln ('Please choose new security level:'#10#13);
  457.      Writeln ('[0] No security in use, this menu is accessible without password');
  458.      Writeln ('[1] All other options available but this menu inaccesible without password');
  459.      Writeln ('[2] As 1, and system editing / saving prohibited, no ZOOM on restricted systems');
  460.      Writeln ('[3] As 2, and system generation prohibited');
  461.      Writeln ('[4] As 3, and all ZOOM and DATA options prohibited');
  462.      Writeln ('    At security levels 2 and above the password is needed to end the program');
  463.      Writeln (#10#13'[H] HELP');
  464.      Beep_Wait;
  465.      If Dummy = 'H' then begin;
  466.         Help('SECURE',' 01234');
  467.         Dummy := ' ';
  468.      end;
  469.    Until (Dummy >='0') and (Dummy <='4');
  470.    Val (Dummy,Security_Level,I);
  471.    Writeln(#10#13'Security Level ',Security_Level,' set: have a nice day.'#10#13'The Computer is YOUR friend');
  472.    Writeln('Press "P" to see your password again, any other key to exit');
  473.    Beep_Wait;
  474.    If Dummy = 'P' then begin;
  475.      Writeln (#10#13'The password is >>',Security_Code,'<<');
  476.      Delay (2000);
  477.    end;
  478. end;
  479.  
  480. Procedure Go_Away(X,Y: Integer);
  481. Begin;
  482.   GotoXY(X,Y);
  483.   Write('N/A');
  484. End;
  485.  
  486. Begin;
  487. End.
  488.